perm filename SAY3.SAI[8,ALS] blob
sn#043239 filedate 1973-05-22 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00002 PAGES
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00002 00002 BEGIN "SAY"
00500 00007 ENDMK
00600 ⊗;
00100 BEGIN "SAY"
00200 DEFINE ⊂="COMMENT"; ⊂ 5/1/73 Runs SIG from FIX output;
00250 ⊂ This version smooths data using routine update after each ripple;
00300 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00400 REQUIRE "SIG3[8,ALS]" LOAD_MODULE;
00500 REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00600 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00700 INTEGER ARRAY LFILE[0:'177];
00800 INTERNAL INTEGER ARRAY INDATA[0:4000];
00900 INTERNAL INTEGER H,I,J,K,L,M,N,P,NF;
01000 INTERNAL INTEGER FLAG,TFLAG,UPCNT;
01100 INTERNAL INTEGER SEGC,INTOT,SEGTOT,HINT,BPT,INFLAG;
01200 INTEGER HINCNT,HCOUNT,HINDEX,EOF,EOFA,BRK;
01300 STRING PREHINT;
01400 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5;
01500 STRING READ1,FILEL,FILEI,TFILE,TFILEI,FILLST;
01600 LABEL START,ZZZZ,ZZZ,ZZ;
01700 DEFINE ⊂="COMMENT",CR="'15",LF="'12",TB="'11";
01800 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
01900 BOOLEAN ER;
02000
02010 INTEGER EOFB,RL;
02020 INTERNAL INTEGER STX,STXX;
02030 STRING FILSTR,SNAMES,SNAME;
02040
02050 INTEGER PROCEDURE UPDATE;
02052 BEGIN "UPDATE"
02054
02056 COMMENT This procedure smooths the output values by adding data
02058 taken from adjacent entries. At the present the central location
02060 data is weighted 8 to 1 for the 4 nearest neighbors for
02062 P2 tables and 16 to 1 for the 6 nearest neighbors for P3
02064 tables. This routine works only for P tables;
02066
02068 INTEGER I,J,K,L,M,N,P,Q,R,Z;
02070 INTEGER GOOD,BAD,PLACE;
02072
02074
02076 FOR I←STXX+10 STEP 74 UNTIL STX-64 DO BEGIN
02078
02079 IF TABLES[I-9]=0 THEN DONE;
02080 PLACE←POINT(3,TABLES[I-9],5);
02082
02084 IF PLACE=2 THEN BEGIN
02086
02088 FOR J←0 STEP 1 UNTIL 7 DO
02090 FOR K←0 STEP 1 UNTIL 7 DO BEGIN
02092 N←J*8+K;
02094 GOOD←POINT(16,TABLES[I+N],31);
02096 L←LDB(GOOD);
02098 BAD←POINT(16,TABLES[I+N],15);
02100 Z←L+LDB(BAD);
02102
02104 L←L LSH 3; Z←Z LSH 3;
02106
02108 IF J>0 THEN BEGIN
02110 GOOD←POINT(16,TABLES[I+N-8],31); L←L+LDB(GOOD);
02112 BAD←POINT(16,TABLES[I+N-8],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02114
02116 IF J<7 THEN BEGIN
02118 GOOD←POINT(16,TABLES[I+N+8],31); L←L+LDB(GOOD);
02120 BAD←POINT(16,TABLES[I+N+8],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02122
02124 IF K>0 THEN BEGIN
02126 GOOD←POINT(16,TABLES[I+N-1],31); L←L+LDB(GOOD);
02128 BAD←POINT(16,TABLES[I+N-1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02130
02132 IF K<7 THEN BEGIN
02134 GOOD←POINT(16,TABLES[I+N+1],31); L←L+LDB(GOOD);
02136 BAD←POINT(16,TABLES[I+N+1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02138
02140 M←((L LSH 4)/Z+1)/2; IF M≥8 THEN M←7;
02142
02144 Q←POINT(32,TABLES[I+N],31);
02146 TABLES[I+N]←(LDB(Q) LSH 4)+M;
02148
02150 END;
02152
02154 END ELSE IF PLACE =3 THEN BEGIN
02156
02158 FOR J←0 STEP 1 UNTIL 3 DO
02160 FOR K←0 STEP 1 UNTIL 3 DO BEGIN
02162 R←J*4+K;
02164 FOR P←0 STEP 1 UNTIL 3 DO BEGIN
02166 N←R*4+P;
02168 GOOD←POINT(16,TABLES[I+N],31);
02170 L←LDB(GOOD);
02172 BAD←POINT(16,TABLES[I+N],15);
02174 Z←L+LDB(BAD);
02176
02178 L←L LSH 4; Z←Z LSH 4;
02180
02182 IF J>0 THEN BEGIN
02184 GOOD←POINT(16,TABLES[I+N-16],31); L←L+LDB(GOOD);
02186 BAD←POINT(16,TABLES[I+N-16],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02188
02190 IF J<3 THEN BEGIN
02192 GOOD←POINT(16,TABLES[I+N+16],31); L←L+LDB(GOOD);
02194 BAD←POINT(16,TABLES[I+N+16],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02196
02198 IF K>0 THEN BEGIN
02200 GOOD←POINT(16,TABLES[I+N-4],31); L←L+LDB(GOOD);
02202 BAD←POINT(16,TABLES[I+N-4],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02204
02206 IF K<3 THEN BEGIN
02208 GOOD←POINT(16,TABLES[I+N+4],31); L←L+LDB(GOOD);
02210 BAD←POINT(16,TABLES[I+N+4],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02212
02214 IF P>0 THEN BEGIN
02216 GOOD←POINT(16,TABLES[I+N-1],31); L←L+LDB(GOOD);
02218 BAD←POINT(16,TABLES[I+N-1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02220
02222 IF P<3 THEN BEGIN
02224 GOOD←POINT(16,TABLES[I+N+1],31); L←L+LDB(GOOD);
02226 BAD←POINT(16,TABLES[I+N+1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02228
02230 M←((L LSH 4)/Z+1)/2; IF M≥8 THEN M←7;
02232 Q←POINT(32,TABLES[I+N],31);
02234 TABLES[I+N]←(LDB(Q) LSH 4)+M;
02236
02238 END;
02240 END;
02242
02244 END;
02246
02248 END;
02250
02252 END "UPDATE";
02280
02290 STRING PROCEDURE HEADER;
02295 BEGIN "HEADER"
02300 STRING H1,H2; INTEGER I,J,K;
02305 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; HINCNT←HINCNT+1; RETURN(PREHINT) END
02310 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
02315 I←LFILE[HINDEX]; K←LDB(POINT(12,I,23)); J←SEGC-K;
02320 IF I=0 THEN BEGIN PREHINT←"NU"; HCOUNT←999; RETURN(PREHINT) END;
02325 IF J ≥ 0 THEN BEGIN "LATCH" H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
02330 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
02335 IF EQU(H1,H2) THEN BEGIN
02340 OUTSTR(CRLF&"Old HEADER version, refuse to learn");
02345 HCOUNT←999; PREHINT←"NU"; RETURN("NU"); END;
02350
02355 IF H1≠0 THEN BEGIN
02360 PREHINT←H1; HCOUNT←LDB(POINT(12,I,35));
02365 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1;
02370 RETURN(PREHINT); DONE END
02375 ELSE BEGIN PREHINT←"NU"; HCOUNT←LDB(POINT(12,I,35));
02380 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
02385 END "LATCH";
02390 PREHINT←"NU"; RETURN(PREHINT); END "XX";
02395 END "HEADER";
02495
03800 STDBRK(1);
03900 SETBREAK(14,"∃",NULL,"INS");
04000
04100 FILEL←"LIST1.L0";
04200 FILEI←"TOO1.DAT[1,THO]"; M←8; INFLAG←0;
04300 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5;
04400 TABIN(INTOT);
04500
04510 FILSTR←STRIN("Ripple learn break-point list (STFILE.TMP) =");
04520 IF FILSTR="" THEN FILSTR←"STFILE.TMP";
04530 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFB);
04540 LOOKUP(CHAN5,FILSTR,ER);
04550 WHILE ER DO BEGIN OUTSTR(CRLF&"Can not find "&FILSTR&
04560 " File = ");
04570 LOOKUP(CHAN5,FILSTR←INCHWL,ER); END;
04580 SNAMES←INPUT(CHAN5,14);
04590 SNAME←SCAN(SNAMES,1,J);
04592 FOR I←19 STEP 1 UNTIL 125 DO BEGIN
04594 IF LIST[I]=CVSIX(SNAME) THEN DONE;
04596 END;
04597 OUTSTR("I="&CVS(I)&" SNAME="&CVXSTR(LIST[I])&CRLF);
04598 STX←I*74; EOFB←0;
04599
04600 FILEL←STRIN("Data file list (LNFILE.TMP) = ");
04602 IF FILEL="" THEN FILEL←"LNFILE.TMP";
04625 START:
04650 WHILE EOFB=0 DO BEGIN "RIPPLE"
04660 IF SNAME="END" THEN DONE;
04700 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFA);
04800 LOOKUP(CHAN5,FILEL,ER); WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEL&
04900 " File = "); LOOKUP(CHAN5,FILEL←INCHWL,ER); END; EOFA←0;
05000 M←8; N←2↑M; NF←2*N;
05100
05200 FILLST←INPUT(CHAN5,14); EOFA←0;
05300
05415 OUTSTR(CRLF&"Ripple learn starting with "&SNAME&" up to ");
05420 STXX←STX; SNAME←SCAN(SNAMES,1,J);
05425 OUTSTR(SNAME&CRLF);
05430 IF SNAME="" THEN DONE;
05450 FOR I←19 STEP 1 UNTIL 125 DO BEGIN
05460 IF LIST[I]=CVSIX(SNAME) THEN DONE; END;
05462 STX←I*74;
05465 OUTSTR("I="&CVS(I)&" SNAME="&CVXSTR(LIST[I])&CRLF);
05467 RL←0;
05480
05490
05500 WHILE EOFA=0 DO BEGIN "LISTREAD"
05600 HINDEX←21; HCOUNT←HINCNT←0;
05700 FILEI←SCAN(FILLST,1,J);
05800 IF FILEI="" THEN DONE;
05900
06000 CLOSE(CHAN4);
06100 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
06200 LOOKUP(CHAN4,FILEI,0);
06300 IF EOF≠0 THEN DONE;
06400 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
06500 SEGTOT←(LFILE[0]*6)%N;
06600 OUTSTR(FILEI&" "&CVS(SEGTOT)&" seg. ");
06700 ARRYIN(CHAN4,INDATA[0],SEGTOT*4);
06800 CLOSE(CHAN4);
06900 BPT←POINT(6,INDATA[0],-1);
07000 ZZ: HINDEX←21; HCOUNT←HINCNT←0;
07100
07200 FOR SEGC←1 STEP 1 UNTIL SEGTOT DO BEGIN
07300 READ1←HEADER;
07400 J←CVSIX(READ1);
07500 FOR I←0 STEP 1 UNTIL 63 DO BEGIN IF PHLIST[I]=0 THEN BEGIN
07600 OUTSTR("Hint not identified for segment = "&READ1&" " &CVS(SEGC)&CRLF);DONE END;
07700 IF PHLIST[I]=J THEN BEGIN HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
07800 END;
07900
08000 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
08100 ZZZZ: SIG(P);
08200 ZZZ: END;
08300
08400 OUTSTR(CVS(HINCNT)&" hints . ");
08450 IF RL=0 THEN RL←1 ELSE BEGIN RL←0; OUTSTR(CRLF); END;
08500 IF EOFA≠0 THEN DONE;
08600 END "LISTREAD";
08650 UPDATE;
08700 TABOUT;
08800 OUTSTR("Tables saved"&CRLF);
08810
08820 END "RIPPLE";
08900
09000 END "SAY";